home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
nktools.zip
/
STRUTIL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-05-14
|
26KB
|
622 lines
UNIT StrUtil;
(*====================================================================*\
|| MODULE NAME: StrUtil ||
|| DEPENDENCIES: System ||
|| LAST MOD ON: 9005.14 ||
|| PROGRAMMERS: Andrea Spilholtz, Mike Temkin, SteveAlter, ||
|| Naoto Kimura ||
|| ||
|| This is a library of string handling routines. Many have been ||
|| rewritten in assembler for the sake of speed. ||
|| ||
|| Modification history ||
|| ||
|| 8907.10 Naoto Kimura ||
|| * Last update before the code was prepared for spring ||
|| semester. ||
|| 8912.10 Naoto Kimura ||
|| * Added LoCase, UpperCaseStr, and LowerCaseStr ||
|| functions. ||
|| 9001.17 Naoto Kimura ||
|| * Started to modify some functions for rewriting in ||
|| assembly. ||
|| 9001.19 Naoto Kimura ||
|| * Minor modifications for efficiency. ||
|| * Renamed some functions: UpperCaseStr --> UpperStr ||
|| and LowerCaseStr --> LowerStr. ||
|| * Changed UpperCase, LowerCase, Alphabet and AlphaNum ||
|| into regular variables instead of typed constants. ||
|| (Just in case the UpCase function gets redefined) ||
|| * Added two new functions, LoCase2 and UpCase2 to ||
|| perform lowercasing and uppercasing as defined by the ||
|| user (by changing the variables LowerTbl and UpperTbl ||
|| look-up tables) ||
|| 9001.20 Naoto Kimura ||
|| * The following routines have been rewritten in ||
|| assembly to speed them up and to reduce memory usage: ||
|| LoCase, LoCase2, UpCase2 ||
|| UpperStr, LowerStr ||
|| RightPos ||
|| RightJustify, LeftJustify, Center, Reverse ||
|| 9001.20 Naoto Kimura ||
|| * The following was rewritten in assembly: ||
|| Copies ||
|| 9002.26 Naoto Kimura ||
|| * Added function LeftPos which does a similar task as ||
|| the RightPos function. ||
|| * Added function Strip to perform stripping of unwanted ||
|| characters. Eventually, this too shall be rewritten ||
|| in assembler. ||
|| 9005.06 Naoto Kimura ||
|| * Rewrote RPos in assembler and split up the assembler ||
|| modules to aid the unused code removal. ||
|| 9005.14 Naoto Kimura ||
|| * Rewrote Strip in assembler. ||
\*====================================================================*)
{$R-} {Range checking off}
{$S+} {Stack checking on}
{$D-} {Debug info off}
{$I-} {I/O checking off}
{$N-} {No numeric coprocessor}
INTERFACE
TYPE
CharLookTbl = ARRAY [Char] OF Char;
CharSet = SET OF Char;
CONST
WhiteSpace : CharSet = [' ',#9,#10,#13];
Numeric : CharSet = ['0'..'9'];
VAR
UpperCase : CharSet;
LowerCase : CharSet;
Alphabet : CharSet;
AlphaNum : CharSet;
{$IFDEF DEBUG}
StdLower : CharLookTbl;
{$ENDIF}
LowerTbl,
UpperTbl : CharLookTbl;
(*--------------------------------------------------------------------*\
| NAME: StrInt |
| |
| This function returns string representation of an integer value. |
| This function really returns the value of the Str procedure, but |
| this way we can use the value w/o having to explicitly call Str with |
| a temporary string. This really only comes in handy if you want to |
| the conversion and then use the string value to do concatenation or |
| pass the string value into a function. |
\*--------------------------------------------------------------------*)
FUNCTION StrInt (
I: Integer
): String;
(*--------------------------------------------------------------------*\
| NAME: StrReal |
| |
| This function returns string representation of a real value. |
| This function really returns the value of the Str procedure, but |
| this way we can use the value w/o having to explicitly call Str with |
| a temporary string. This really only comes in handy if you want to |
| the conversion and then use the string value to do concatenation or |
| pass the string value into a function. |
\*--------------------------------------------------------------------*)
FUNCTION StrReal (
R: Real
): String;
(*--------------------------------------------------------------------*\
| NAME: LoCase |
| |
| This function performs the opposite function as the UpCase |
| function; it takes an upper case character and transforms it into |
| its lower case form. |
\*--------------------------------------------------------------------*)
FUNCTION LoCase (
C: Char
): Char;
(*--------------------------------------------------------------------*\
| NAME: LoCase2 |
| |
| This function performs a similar function as the LoCase |
| function; it takes an upper case character and transforms it into |
| its lower case form. The difference is that the the lowercasing can |
| be altered by the user. |
\*--------------------------------------------------------------------*)
FUNCTION LoCase2 (
C: Char
): Char;
(*--------------------------------------------------------------------*\
| NAME: UpCase2 |
| |
| This function performs a similar function as the UpCase |
| function; it takes an lower case character and transforms it into |
| its upper case form. The difference is that the the uppercasing can |
| be altered by the user. |
\*--------------------------------------------------------------------*)
FUNCTION UpCase2 (
C: Char
): Char;
(*--------------------------------------------------------------------*\
| NAME: UpperStr |
| |
| This function returns the passed string with all the lower case |
| characters transformed into upper case characters. |
\*--------------------------------------------------------------------*)
FUNCTION UpperStr (
S :String
): String;
(*--------------------------------------------------------------------*\
| NAME: LowerStr |
| |
| This function returns the passed string with all the upper case |
| characters transformed into lower case characters. |
\*--------------------------------------------------------------------*)
FUNCTION LowerStr (
S :String
): String;
(*--------------------------------------------------------------------*\
| NAME: RightPos |
| |
| This function returns the last matching position of character |
| "C" in "S". |
\*--------------------------------------------------------------------*)
FUNCTION RightPos (
S : String;
C : Char
): Integer;
(*--------------------------------------------------------------------*\
| NAME: LeftPos |
| |
| This function returns the first matching position of character |
| "C" in "S". |
\*--------------------------------------------------------------------*)
FUNCTION LeftPos (
S : String;
C : Char
): Integer;
(*--------------------------------------------------------------------*\
| NAME: RPos |
| |
| This function returns the last matching position of "Needle" in |
| "HayStack." |
\*--------------------------------------------------------------------*)
FUNCTION RPos(
Needle,
HayStack : string
) : byte;
(*--------------------------------------------------------------------*\
| NAME: CharSetPos |
| |
| This routine returns the first position of a member of a set |
| "Srch" within the string "HayStack." |
\*--------------------------------------------------------------------*)
FUNCTION CharSetPos(
Srch : CharSet;
HayStack : string
) : byte;
(*--------------------------------------------------------------------*\
| NAME: RCharSetPos |
| |
| This routine returns the last position of a member of a set |
| "Srch" within the string "HayStack." |
\*--------------------------------------------------------------------*)
FUNCTION RCharSetPos(
Srch : CharSet;
HayStack : string
) : byte;
(*--------------------------------------------------------------------*\
| NAME: CharSetStrip |
| |
| This function strips off the specified characters from Original. |
| Leading characters to strip off are specified in LeadSet and |
| trailing characters to strip off are specifed in TrailSet. |
\*--------------------------------------------------------------------*)
FUNCTION CharSetStrip (
Original : string;
LeadSet,
TrailSet : CharSet
) : string;
(*--------------------------------------------------------------------*\
| NAME: Copies |
| |
| This function returns as many copies of a string concatenated |
| together as requested. |
\*--------------------------------------------------------------------*)
FUNCTION Copies (
Original : String;
Num : Byte
) : String;
(*--------------------------------------------------------------------*\
| NAME: RightJustify |
| |
| This function returns a string that has the string "Original" |
| right justified in a field of length "width" of the character |
| "filler". If the string is longer than the field, the string will |
| be truncated at the field width. |
\*--------------------------------------------------------------------*)
FUNCTION RightJustify (
Original : string;
width : byte;
filler : char
) : string;
(*--------------------------------------------------------------------*\
| NAME: LeftJustify |
| |
| This function returns a string that has the string "Original" |
| left justified in a field of length "width" of the character |
| "filler". If the string is longer than the field, the string will |
| be truncated at the field width. |
\*--------------------------------------------------------------------*)
FUNCTION LeftJustify (
Original : string;
width : byte;
filler : char
) : string;
(*--------------------------------------------------------------------*\
| NAME: Center |
| |
| This function returns a string that has the string "Original" |
| centered in a field of length "width" of the character "filler". If |
| the string is longer than the field, the string will be truncated at |
| the field width. |
\*--------------------------------------------------------------------*)
FUNCTION Center (
Original : string;
width : byte;
filler : char
) : string;
(*--------------------------------------------------------------------*\
| NAME: Strip |
| |
| This function strips off unwanted characters from either the |
| left, right or both ends of a string.
\*--------------------------------------------------------------------*)
function Strip (
Original : String;
Unwanted : String;
Location : Char
) : String;
(*--------------------------------------------------------------------*\
| NAME: SkipStr |
| |
| This routine is used to grab a copy of the string, past the |
| location of the given pattern. |
\*--------------------------------------------------------------------*)
FUNCTION SkipStr (
Original,
pattern : string
) : string;
(*--------------------------------------------------------------------*\
| NAME: Reverse |
| |
| This function returns a copy of a string that is reversed. |
\*--------------------------------------------------------------------*)
FUNCTION Reverse (
Original : string
) : string;
(*--------------------------------------------------------------------*\
| NAME: FindPos |
| |
| This function returns the position of the character "C" within |
| string "S," ignoring any occurances before the "P"th position with |
| "S." |
\*--------------------------------------------------------------------*)
FUNCTION FindPos (
S : String;
C : Char;
P : Integer
): Integer;
IMPLEMENTATION
VAR
WorkBuffer : String;
{$IFNDEF DEBUG}
StdLower : CharLookTbl;
{$ENDIF}
(*--------------------------------------------------------------------*\
| NAME: StrInt |
\*--------------------------------------------------------------------*)
FUNCTION StrInt (
I: Integer
): String;
BEGIN
Str(I,WorkBuffer); StrInt := WorkBuffer;
END; (* StrInt *)
(*--------------------------------------------------------------------*\
| NAME: StrReal |
\*--------------------------------------------------------------------*)
FUNCTION StrReal (
R: Real
): String;
BEGIN
Str(R:1:5,WorkBuffer); StrReal := WorkBuffer;
END; (* StrReal *)
{$L Cases.OBJ}
(*--------------------------------------------------------------------*\
| NAME: LoCase |
\*--------------------------------------------------------------------*)
FUNCTION LoCase (C: Char): Char;
External;
(*--------------------------------------------------------------------*\
| NAME: LoCase2 |
\*--------------------------------------------------------------------*)
FUNCTION LoCase2 (C: Char): Char;
External;
(*--------------------------------------------------------------------*\
| NAME: UpCase2 |
\*--------------------------------------------------------------------*)
FUNCTION UpCase2 (C: Char): Char;
External;
(*--------------------------------------------------------------------*\
| NAME: UpperStr |
\*--------------------------------------------------------------------*)
FUNCTION UpperStr ( S :String ): String;
External;
(*--------------------------------------------------------------------*\
| NAME: LowerStr |
\*--------------------------------------------------------------------*)
FUNCTION LowerStr ( S :String ): String;
External;
{$L StrPos.OBJ}
(*--------------------------------------------------------------------*\
| NAME: RPos |
\*--------------------------------------------------------------------*)
FUNCTION RPos(
Needle,
HayStack : string
) : byte;
External;
(*--------------------------------------------------------------------*\
| NAME: RightPos |
\*--------------------------------------------------------------------*)
FUNCTION RightPos ( S:String; C:Char ) : Integer;
External;
(*--------------------------------------------------------------------*\
| NAME: LeftPos |
\*--------------------------------------------------------------------*)
FUNCTION LeftPos ( S:String; C:Char ) : Integer;
External;
(*--------------------------------------------------------------------*\
| NAME: CharSetPos |
\*--------------------------------------------------------------------*)
FUNCTION CharSetPos(
Srch : CharSet;
HayStack : string
) : byte;
VAR
i : byte;
BEGIN
IF (HayStack = '') OR (Srch = []) THEN
CharSetPos := 0
ELSE BEGIN
FOR i := 1 TO length(HayStack) DO
IF HayStack[i] IN Srch THEN BEGIN
CharSetPos := i;
exit
END;
CharSetPos := 0
END
END; (* CharSetPos *)
(*--------------------------------------------------------------------*\
| NAME: RCharSetPos |
\*--------------------------------------------------------------------*)
FUNCTION RCharSetPos(
Srch : CharSet;
HayStack : string
) : byte;
VAR
i : byte;
BEGIN
IF (HayStack = '') OR (Srch = []) THEN
RCharSetPos := 0
ELSE BEGIN
FOR i := length(HayStack) DOWNTO 1 DO
IF HayStack[i] IN Srch THEN BEGIN
RCharSetPos := i;
exit
END;
RCharSetPos := 0
END
END; (* RCharSetPos *)
(*--------------------------------------------------------------------*\
| NAME: CharSetStrip |
\*--------------------------------------------------------------------*)
FUNCTION CharSetStrip(
Original : string;
LeadSet,
TrailSet : CharSet
) : string;
VAR
Left,
Right : byte;
stop : boolean;
BEGIN
Left := 1;
Right := length(Original);
IF Left>Right THEN
stop := FALSE
ELSE
stop := NOT (Original[Left] IN LeadSet)
AND NOT (Original[Right] IN TrailSet);
WHILE NOT (stop OR (Right<Left)) DO BEGIN
stop := TRUE;
IF Original[Left] IN LeadSet THEN BEGIN
inc(Left);
stop := FALSE
END;
IF Original[Right] IN TrailSet THEN BEGIN
dec(Right);
stop := FALSE
END
END;
IF stop THEN
CharSetStrip := copy(Original,Left,Right-Left+1)
ELSE
CharSetStrip := ''
END; (* CharSetStrip *)
{$L StrFmt.OBJ}
(*--------------------------------------------------------------------*\
| NAME: Copies |
\*--------------------------------------------------------------------*)
FUNCTION Copies (
Original : String;
Num : Byte
) : String;
External;
(*--------------------------------------------------------------------*\
| NAME: RightJustify |
\*--------------------------------------------------------------------*)
FUNCTION RightJustify(
Original : string;
width : byte;
filler : char
) : string;
External;
(*--------------------------------------------------------------------*\
| NAME: LeftJustify |
\*--------------------------------------------------------------------*)
FUNCTION LeftJustify(
Original : string;
width : byte;
filler : char
) : string;
External;
(*--------------------------------------------------------------------*\
| NAME: Center |
\*--------------------------------------------------------------------*)
FUNCTION Center(
Original : string;
width : byte;
filler : char
) : string;
External;
(*--------------------------------------------------------------------*\
| NAME: Strip |
\*--------------------------------------------------------------------*)
function Strip (
Original : String;
Unwanted : String;
Location : Char
) : String;
External;
(*--------------------------------------------------------------------*\
| NAME: SkipStr |
\*--------------------------------------------------------------------*)
FUNCTION SkipStr(
original,
pattern : string
) : string;
BEGIN
SkipStr := copy(original,
pos(pattern,original)+length(pattern),
length(original))
END; (* SkipStr *)
(*--------------------------------------------------------------------*\
| NAME: Reverse |
\*--------------------------------------------------------------------*)
FUNCTION Reverse( Original : String ) : String;
External;
(*--------------------------------------------------------------------*\
| NAME: FindPos |
\*--------------------------------------------------------------------*)
FUNCTION FindPos (
S : String;
C : Char;
P : Integer
): Integer;
VAR
T : Integer;
BEGIN
IF (P < 1) OR (P > Length(S)) THEN
FindPos := 0
ELSE BEGIN
T := Pos(C,Copy(S,P,Length(S)));
IF T <> 0 THEN
T := T - 1 + P;
FindPos := T
END
END; (* FindPos *)
PROCEDURE Init;
VAR
C : Char;
BEGIN
LowerCase := [];
UpperCase := [];
{$IFDEF DEBUG}
FillChar(StdLower,SizeOf(StdLower),128);
FillChar(LowerTbl,SizeOf(LowerTbl),128);
FillChar(UpperTbl,SizeOf(UpperTbl),128);
{$ENDIF}
FOR C := chr(0) TO chr(255) DO BEGIN
UpperTbl[C] := C;
StdLower[C] := C;
LowerTbl[C] := C
END;
FOR C := chr(0) TO chr(255) DO
IF UpCase(C) <> C THEN BEGIN
StdLower[UpCase(C)] := C;
LowerTbl[UpCase(C)] := C;
UpperTbl[C] := UpCase(C);
UpperCase := UpperCase + [UpCase(C)];
LowerCase := LowerCase + [C]
END;
Alphabet := LowerCase + UpperCase;
AlphaNum := Alphabet + Numeric
END;
BEGIN
Init;
END.
